Cambio climático y salud del recién nacido.

Avances

José Daniel Conejeros | jdconejeros@uc.cl

7 de mayo de 2024

Avances

Respecto a la reunión anterior

Objetivo: analizar y cuantificar la relación entre una exposición de temperaturas que varían en el tiempo y el peso al nacer, teniendo en cuenta los retrasos (lag’s) en el tiempo.

  • Algunos cambios de estrategia de generación de datos

  • Revisión de materiales sobre la estrategia de estudio:

    • Análisis de series de tiempo en epidemiología ambiental
    • Distributed lag models (DLMs)
    • Distributed lag no-linear models (DLNMs)
      • Permite evaluar como el efecto de la exposición se distribuye en el tiempo.
      • Este efecto se puede incorporar de forma no lineal.
      • Pueden ser modelos de alta dimensión si se consideran muchos lags.
      • Se incorporan funciones flexibles que requieren de otros parámetros para su estimación.
  • Algunos avances en la parte descriptiva de los datos

Algunos resultados

Función generadora de los datos

Antes teníamos esto:

Click para ver el código
calculate_hum_stats <- function(row, temp_data) {
  # Adjust temp_data with data.table() format
  setDT(temp_data)
  
  # Dates are dates 
  if (!inherits(row$date_start_week, "Date")) {
    row$date_start_week <- as.Date(row$date_start_week)
  }
  if (!inherits(row$date_end_week, "Date")) {
    row$date_end_week <- as.Date(row$date_end_week)
  }
  
  # Extract values for each row
  start_date <- row$date_start_week
  end_date <- row$date_end_week
  comuna_id <- row$comuna
  
  # New temporal data with filter by time and district
  week_temperatures <- temp_data[fecha >= start_date & fecha < end_date & comuna == comuna_id, 
                                 .(h_min, h_max, xh_diario)]
  
  # Blank Results 
  result <- as.list(row)
  
  # NA with missing values when haven't information in temp data 
  if (nrow(week_temperatures) == 0) {
    result <- c(result, list(hum_mean=NA, hum_min=NA, hum_max=NA,
                             hum_mean_min=NA, hum_mean_max=NA))
    return(as.data.table(result))
  }
  
  # Calculate stats and return results as data.frame()
  result <- c(result, list(
    hum_mean = mean(week_temperatures$xh_diario, na.rm = TRUE),
    hum_min = min(week_temperatures$h_min, na.rm = TRUE),
    hum_max = max(week_temperatures$h_max, na.rm = TRUE),
    hum_mean_min = mean(week_temperatures$h_min, na.rm = TRUE),
    hum_mean_max = mean(week_temperatures$h_max, na.rm = TRUE)
  ))
  
  return(as.data.table(result))
}

Función generadora de los datos

Hoy tenemos esto:

Click para ver el código
calculate_temperature_stats <- function(row, temp_data) {
  # Asegurarse que tanto row como temp_data son data.table
  setDT(row)
  setDT(temp_data)
  
  # Convertir fechas solo si es necesario
  row[, date_start_week := as.Date(date_start_week)]
  row[, date_end_week := as.Date(date_end_week)]
  
  # Filtrar los datos de temperatura
  week_temperatures <- temp_data[fecha >= row$date_start_week[1] & fecha < row$date_end_week[1] & comuna == row$comuna[1]]
  
  # Resultados en blanco o con NA si no hay datos
  if (nrow(week_temperatures) == 0) {
    return(data.table(row, temp_mean=NA, temp_min=NA, temp_max=NA, temp_mean_min=NA, temp_mean_max=NA))
  } else {
    return(data.table(row, 
                      temp_mean = mean(week_temperatures$xt_diario, na.rm = TRUE),
                      temp_min = min(week_temperatures$t_min, na.rm = TRUE),
                      temp_max = max(week_temperatures$t_max, na.rm = TRUE),
                      temp_mean_min = mean(week_temperatures$t_min, na.rm = TRUE),
                      temp_mean_max = mean(week_temperatures$t_max, na.rm = TRUE)))
  }
}

Sin embargo aún estamos con unas pequeñas “panas” de ejecución por temas computacionales.

Datos actuales

Click para ver el código
glimpse(births)
Rows: 5.597.819
Columns: 35
$ sexo             <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
$ dia_nac          <dbl> 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 1…
$ mes_nac          <dbl> 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,…
$ ano_nac          <dbl> 2018, 2018, 2018, 2018, 2018, 2018, 2018, 2018, 2018,…
$ semanas          <dbl> 40, 40, 40, 40, 40, 40, 40, 40, 40, 40, 40, 40, 40, 4…
$ peso             <dbl> 3290, 3290, 3290, 3290, 3290, 3290, 3290, 3290, 3290,…
$ talla            <dbl> 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 5…
$ comuna           <dbl> 2201, 2201, 2201, 2201, 2201, 2201, 2201, 2201, 2201,…
$ region           <dbl> 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,…
$ edad_madre       <dbl> 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 3…
$ nivel_madre      <dbl> 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,…
$ edad_padre       <dbl> 34, 34, 34, 34, 34, 34, 34, 34, 34, 34, 34, 34, 34, 3…
$ nivel_padre      <dbl> 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,…
$ activ_madre      <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
$ tipo_parto       <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
$ activ_padre      <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, N…
$ date_nac         <dbl> 17726, 17726, 17726, 17726, 17726, 17726, 17726, 1772…
$ id               <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
$ date_start       <dbl> 17453, 17453, 17453, 17453, 17453, 17453, 17453, 1745…
$ date_end         <dbl> 17726, 17726, 17726, 17726, 17726, 17726, 17726, 1772…
$ week_gest        <dbl> 17453, 17460, 17467, 17474, 17481, 17488, 17495, 1750…
$ week_gest_num    <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16…
$ date_start_week  <date> 2017-10-07, 2017-10-14, 2017-10-21, 2017-10-28, 2017…
$ date_end_week    <date> 2017-10-14, 2017-10-21, 2017-10-28, 2017-11-04, 2017…
$ temp_mean        <dbl> 13,54061, 17,85728, 15,74443, 13,28057, 15,49821, 16,…
$ temp_min         <dbl> -0,8, 5,1, 2,1, 0,2, 3,4, 4,5, 1,8, 1,8, 2,4, 3,2, 4,…
$ temp_max         <dbl> 24,3, 29,0, 26,3, 24,0, 25,8, 25,8, 25,5, 25,1, 25,8,…
$ temp_mean_min    <dbl> 1,900000, 7,657143, 4,557143, 1,983333, 4,714286, 7,2…
$ temp_mean_max    <dbl> 23,31429, 26,91429, 24,91429, 22,67143, 24,45714, 25,…
$ nombre_comuna    <chr> "Calama", "Calama", "Calama", "Calama", "Calama", "Ca…
$ codigo_provincia <dbl> 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 2…
$ nombre_provincia <chr> "El Loa", "El Loa", "El Loa", "El Loa", "El Loa", "El…
$ codigo_region    <dbl> 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,…
$ nombre_region    <chr> "Antofagasta", "Antofagasta", "Antofagasta", "Antofag…
$ zona             <fct> Norte, Norte, Norte, Norte, Norte, Norte, Norte, Nort…

Datos actuales

Click para ver el código
length(unique(births$id))
[1] 144540
Click para ver el código
cat("% de Avance Muestra:", round((length(unique(births$id))/361922)*100,0), "%")
% de Avance Muestra: 40 %

Análisis preliminares

Click para ver el código
births <- births %>% 
  mutate(temp_mean=if_else(is.infinite(temp_mean), NA, temp_mean),
         temp_min=if_else(is.infinite(temp_min), NA, temp_min),
         temp_max=if_else(is.infinite(temp_max), NA, temp_max)
         )

temp <- births %>% 
  group_by(zona, ano_nac, mes_nac, dia_nac) %>% 
  summarise(temp_media = mean(temp_mean, na.rm = TRUE), 
            temp_min = mean(temp_min, na.rm = TRUE), 
            temp_max = mean(temp_max, na.rm = TRUE), 
            peso = mean(peso, na.rm = TRUE)) %>% 
  mutate(date_nac=make_date(year=ano_nac, month=mes_nac, day=dia_nac)) %>% 
  pivot_longer(!c(zona, ano_nac, mes_nac, dia_nac, date_nac, peso), 
               names_to = "temperatures", 
               values_to = "values")

peso <- births %>% 
  group_by(zona, ano_nac, mes_nac, dia_nac) %>% 
  summarise(peso = mean(peso, na.rm = TRUE)) %>% 
  mutate(date_nac=make_date(year=ano_nac, month=mes_nac, day=dia_nac))
  
ggplot(temp, aes(x = date_nac)) +
  geom_line(aes(y = values, fill=factor(temperatures), color=factor(temperatures))) + 
  scale_y_continuous(breaks=seq(-10, 40, by=10)) +
  # geom_line(data=peso, aes(y = peso/100)) + 
  # scale_y_continuous(name = "Temperatura", limits = c(-20 , 60),
  #                    sec.axis = sec_axis(~.*100, name = "Peso del nacimiento (kg)")) +
  scale_x_date(date_breaks = "1 year", date_labels = "%Y") +
  facet_wrap(~ zona, scales = "free_x", ncol=1)  +
  labs(x = "", y = "Temperatura") +
  theme_light() +
  theme(axis.text.x = element_text(angle = 0, hjust = 1), 
        legend.title = element_blank(),
        legend.position = "top", 
        strip.background = element_blank(),
        strip.text = element_text(color="black", face = "bold")) 

Figura 1: Distribución de la temperatura en el tiempo y zona

Aún en camino

  • Implementación de la función.

  • Validación y revisión de los datos.

  • Implementar estrategias de análisis.

Cambio climático y salud del recién nacido.

Avances

Repositorio en Github: https://github.com/JDConejeros/CIIIA-ClimateBirthWeightAnalysis

© José Daniel Conejeros | jdconejeros@uc.cl | JDConejeros

Proyecto Redes | Hecho en Quarto